{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressCoreLibrary                                           }
{                                                                    }
{       Copyright (c) 1998-2014 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSCORELIBRARY AND ALL            }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit dxCoreGraphics;

{$I cxVer.inc}

{$ALIGN ON} 
{$MINENUMSIZE 4} 

interface

uses
  Windows, Graphics;

const
  AlphaShift  = 24;
  {$EXTERNALSYM AlphaShift}
  RedShift    = 16;
  {$EXTERNALSYM RedShift}
  GreenShift  = 8;
  {$EXTERNALSYM GreenShift}
  BlueShift   = 0;
  {$EXTERNALSYM BlueShift}

  AlphaMask   = $ff000000;
  {$EXTERNALSYM AlphaMask}
  RedMask     = $00ff0000;
  {$EXTERNALSYM RedMask}
  GreenMask   = $0000ff00;
  {$EXTERNALSYM GreenMask}
  BlueMask    = $000000ff;
  {$EXTERNALSYM BlueMask}

type
  TdxAlphaColor = type DWORD;
  PdxAlphaColor  = ^TdxAlphaColor;

  TdxAlphaColors = array of TdxAlphaColor;
  TRGBColors = array of TRGBQuad;

  TdxGraphicUnit = (
    guWorld,      // 0 -- World coordinate (non-physical unit)
    guDisplay,    // 1 -- Variable -- for PageTransform only
    guPixel,      // 2 -- Each unit is one device pixel.
    guPoint,      // 3 -- Each unit is a printer's point, or 1/72 inch.
    guInch,       // 4 -- Each unit is 1 inch.
    guDocument,   // 5 -- Each unit is 1/300 inch.
    guMillimeter  // 6 -- Each unit is 1 millimeter.
  ); 


// dxAlphaColor functions
function dxAlphaColorToColor(AColor: TdxAlphaColor): TColor; overload;
function dxAlphaColorToColor(AColor: TdxAlphaColor; out AAlpha: Byte): TColor; overload;
function dxAlphaColorToRGBQuad(AColor: TdxAlphaColor): TRGBQuad;
function dxColorToAlphaColor(AColor: TColor; AAlpha: Byte = 255): TdxAlphaColor;
function dxColorRefToAlphaColor(AREF: COLORREF): TdxAlphaColor;
function dxAlphaColorToColorRef(AColor: TdxAlphaColor): COLORREF;
function dxGetAlpha(AColor: TdxAlphaColor): Byte;
function dxGetRed(AColor: TdxAlphaColor): Byte;
function dxGetGreen(AColor: TdxAlphaColor): Byte;
function dxGetBlue(AColor: TdxAlphaColor): Byte;
function dxMakeAlphaColor(R, G, B: Byte): TdxAlphaColor; overload;
function dxMakeAlphaColor(A, R, G, B: Byte): TdxAlphaColor; overload;
function dxMakeAlphaColor(AColor: TColor; AAlpha: Byte = 255): TdxAlphaColor; overload;

// graphic functions
function dxColorToRGBQuad(AColor: TColor; AReserved: Byte = 0): TRGBQuad;
function dxRGBQuadToColor(const ARGB: TRGBQuad): TColor;
function cxGetBitmapPixelFormat(ABitmap: TBitmap): Integer;
procedure dxFillBitmapInfoHeader(out AHeader: TBitmapInfoHeader; ABitmap: TBitmap; ATopDownDIB: WordBool); overload;
procedure dxFillBitmapInfoHeader(out AHeader: TBitmapInfoHeader; AWidth, AHeight: Integer; ATopDownDIB: WordBool); overload;
function GetBitmapBits(ABitmap: TBitmap; var AColors: TRGBColors; ATopDownDIB: Boolean): Boolean;
procedure GetBitmapBitsByScanLine(ABitmap: TBitmap; var AColors: TRGBColors);
procedure SetBitmapBits(ABitmap: TBitmap; const AColors: TRGBColors; ATopDownDIB: Boolean);
function dxIsAlphaUsed(ABitmap: TBitmap): Boolean;

// getting graphic objects' data
function dxGetBitmapData(ABitmapHandle: HBITMAP; out ABitmapData: Windows.TBitmap): Boolean;
function dxGetBrushData(ABrushHandle: HBRUSH; out ALogBrush: TLogBrush): Boolean; overload;
function dxGetBrushData(ABrushHandle: HBRUSH): TLogBrush; overload;
function dxGetFontData(AFontHandle: HFONT; out ALogFont: TLogFont): Boolean; overload;
function dxGetFontData(AFontHandle: HFONT): TLogFont; overload;
function dxGetPenData(APenHandle: HPEN; out ALogPen: TLogPen): Boolean;

implementation

uses
  dxCore;

// graphic functions
type
  TRGBA = packed record
    R: Byte;
    G: Byte;
    B: Byte;
    A: Byte;
  end;

// dxAlphaColor functions
function dxAlphaColorToColor(AColor: TdxAlphaColor): TColor;
var
  AAlpha: Byte;
begin
  Result := dxAlphaColorToColor(AColor, AAlpha);
end;

function dxAlphaColorToColor(AColor: TdxAlphaColor; out AAlpha: Byte): TColor;
begin
  if AColor = 0 then
  begin
    Result := clNone;
    AAlpha := 0;
  end
  else
  begin
    AAlpha := AColor shr AlphaShift;
    Result := RGB(Byte(AColor shr RedShift), Byte(AColor shr GreenShift), Byte(AColor shr BlueShift));
  end;
end;

function dxAlphaColorToRGBQuad(AColor: TdxAlphaColor): TRGBQuad;
begin
  Result.rgbBlue := Byte(AColor shr BlueShift);
  Result.rgbGreen := Byte(AColor shr GreenShift);
  Result.rgbRed := Byte(AColor shr RedShift);
  Result.rgbReserved := AColor shr AlphaShift;
end;

function dxColorToAlphaColor(AColor: TColor; AAlpha: Byte = 255): TdxAlphaColor;
begin
  if AColor = clNone then
    Result := 0
  else
    Result := TdxAlphaColor(dxColorToRGBQuad(AColor, AAlpha));
end;

function dxColorRefToAlphaColor(AREF: COLORREF): TdxAlphaColor;
begin
  Result := dxMakeAlphaColor(255, GetRValue(AREF), GetGValue(AREF), GetBValue(AREF));
end;

function dxAlphaColorToColorRef(AColor: TdxAlphaColor): COLORREF;
begin
  Result := RGB(dxGetRed(AColor), dxGetGreen(AColor), dxGetBlue(AColor));
end;

function dxGetAlpha(AColor: TdxAlphaColor): Byte;
begin
  Result := Byte(AColor shr AlphaShift);
end;

function dxGetRed(AColor: TdxAlphaColor): Byte;
begin
  Result := Byte(AColor shr RedShift);
end;

function dxGetGreen(AColor: TdxAlphaColor): Byte;
begin
  Result := Byte(AColor shr GreenShift);
end;

function dxGetBlue(AColor: TdxAlphaColor): Byte;
begin
  Result := Byte(AColor shr BlueShift);
end;

function dxMakeAlphaColor(R, G, B: Byte): TdxAlphaColor; overload;
begin
  Result := dxMakeAlphaColor(255, R, G, B);
end;

function dxMakeAlphaColor(A, R, G, B: Byte): TdxAlphaColor; overload;
begin
  Result := (DWORD(B) shl BlueShift) or (DWORD(G) shl GreenShift) or (DWORD(R) shl RedShift) or (DWORD(A) shl AlphaShift);
end;

function dxMakeAlphaColor(AColor: TColor; AAlpha: Byte = 255): TdxAlphaColor; overload;
begin
  if AColor = clNone then
    Result := 0
  else
    Result := dxMakeAlphaColor(AAlpha, GetRValue(AColor), GetGValue(AColor), GetBValue(AColor));
end;

function dxColorToRGBQuad(AColor: TColor; AReserved: Byte = 0): TRGBQuad;
var
  ATemp: TRGBA;
begin
  DWORD(ATemp) := ColorToRGB(AColor);
  Result.rgbBlue := ATemp.B;
  Result.rgbRed := ATemp.R;
  Result.rgbGreen := ATemp.G;
  Result.rgbReserved := AReserved;
end;

function dxRGBQuadToColor(const ARGB: TRGBQuad): TColor;
var
  ATemp: TRGBA;
begin
  ATemp.B := ARGB.rgbBlue;
  ATemp.R := ARGB.rgbRed;
  ATemp.G := ARGB.rgbGreen;
  ATemp.A := ARGB.rgbReserved;
  Result := DWORD(ATemp);
end;

function cxGetBitmapPixelFormat(ABitmap: TBitmap): Integer;
const
  ABitCounts: array [pf1Bit..pf32Bit] of Byte = (1,4,8,16,16,24,32);
begin
  case ABitmap.PixelFormat of
    pf1bit..pf32Bit: Result := ABitCounts[ABitmap.PixelFormat]
  else
    Result := GetDeviceCaps(ABitmap.Canvas.Handle, BITSPIXEL);
  end;
end;

procedure dxFillBitmapInfoHeader(out AHeader: TBitmapInfoHeader; AWidth, AHeight: Integer; ATopDownDIB: WordBool);
begin
  cxZeroMemory(@AHeader, SizeOf(AHeader));
  AHeader.biSize := SizeOf(TBitmapInfoHeader);
  AHeader.biWidth := AWidth;
  if ATopDownDIB then
    AHeader.biHeight := -AHeight
  else
    AHeader.biHeight := AHeight;
  AHeader.biPlanes := 1;
  AHeader.biBitCount := 32;
  AHeader.biCompression := BI_RGB;
end;

procedure dxFillBitmapInfoHeader(out AHeader: TBitmapInfoHeader; ABitmap: TBitmap; ATopDownDIB: WordBool);
begin
  dxFillBitmapInfoHeader(AHeader, ABitmap.Width, ABitmap.Height, ATopDownDIB);
end;

function InternalGetDIB(ABitmap: TBitmap; const AColors: TRGBColors; ATopDownDIB: WordBool): Boolean;

  function GetStartScan(AIndex: Integer): Integer;
  begin
    if ATopDownDIB then
      Result := ABitmap.Height - 1 - AIndex
    else
      Result := AIndex;
  end;

var
  ADC: HDC;
  ABitmapInfo: TBitmapInfo;
  I: Integer;
  AScanLineResult: boolean;
  P: Pointer;
begin
  if (ABitmap.Width <> 0) and (ABitmap.Height <> 0) then
  begin
    dxFillBitmapInfoHeader(ABitmapInfo.bmiHeader, ABitmap, ATopDownDIB);
    ADC := CreateCompatibleDC(0);
    try
      Result := GetDIBits(ADC, ABitmap.Handle, 0, ABitmap.Height, AColors, ABitmapInfo, DIB_RGB_COLORS) <> 0;
      if not Result then
      begin
        Result := True;
        for I := 0 to ABitmap.Height - 1 do
        begin
          AScanLineResult := GetDIBits(ADC, ABitmap.Handle, GetStartScan(I), 1, @AColors[ABitmap.Width * I], ABitmapInfo, DIB_RGB_COLORS) <> 0;
          if not AScanLineResult then
          begin
            P := cxAllocMem(ABitmap.Width * SizeOf(TRGBQuad));
            try
              AScanLineResult := GetDIBits(ADC, ABitmap.Handle, GetStartScan(I), 1, P, ABitmapInfo, DIB_RGB_COLORS) <> 0;
              cxCopyData(P, @AColors[ABitmap.Width * I], ABitmap.Width * SizeOf(TRGBQuad));
            finally
              cxFreeMem(P);
            end;
          end;
          Result := Result and AScanLineResult;
        end;
      end;
    finally
      DeleteDC(ADC);
    end;
  end
  else
    Result := False;
end;

function InternalSetDIB(ABitmap: TBitmap; const AColors: TRGBColors; ATopDownDIB: WordBool): Boolean;
var
  ADC: HDC;
  ABitmapInfo: TBitmapInfo;
begin
  if (ABitmap.Width <> 0) and (ABitmap.Height <> 0) then
  begin
    dxFillBitmapInfoHeader(ABitmapInfo.bmiHeader, ABitmap, ATopDownDIB);
    ADC := CreateCompatibleDC(0);
    try
      Result := SetDIBits(ADC, ABitmap.Handle, 0, ABitmap.Height, AColors, ABitmapInfo, DIB_RGB_COLORS) <> 0;
    finally
      DeleteDC(ADC);
    end;
  end
  else
    Result := False;
end;

function GetBitmapBits(ABitmap: TBitmap; var AColors: TRGBColors; ATopDownDIB: Boolean): Boolean;
begin
  SetLength(AColors, ABitmap.Width * ABitmap.Height);
  Result := InternalGetDIB(ABitmap, AColors, ATopDownDIB);
end;

procedure GetBitmapBitsByScanLine(ABitmap: TBitmap; var AColors: TRGBColors);
var
  AIndex: Integer;
  AQuad: PRGBQuad;
  I, J: Integer;
begin
  // todo: try to get bitmap bits if GetDIBits fail
  if ABitmap.PixelFormat = pf32bit then
  begin
    if Length(AColors) <> ABitmap.Width * ABitmap.Height then
      SetLength(AColors, ABitmap.Width * ABitmap.Height);
    AIndex := 0;
    for J := 0 to ABitmap.Height - 1 do
    begin
      AQuad := ABitmap.ScanLine[J];
      for I := 0 to ABitmap.Width - 1 do
      begin
        AColors[AIndex] := AQuad^;
        Inc(AQuad);
        Inc(AIndex);
      end;
    end;
  end;
end;

procedure SetBitmapBits(ABitmap: TBitmap; const AColors: TRGBColors; ATopDownDIB: Boolean);
begin
  InternalSetDIB(ABitmap, AColors, ATopDownDIB);
end;

function dxIsAlphaUsed(ABitmap: TBitmap): Boolean;

  function InternalIsBitmapAlphaUsed: Boolean;
  var
    AColors: TRGBColors;
    I: Integer;
  begin
    Result := False;
    GetBitmapBits(ABitmap, AColors, False);
    for I := Low(AColors) to High(AColors) do
    begin
      Result := AColors[I].rgbReserved <> 0;
      if Result then
        Break;
    end;
  end;

begin
  Result := (cxGetBitmapPixelFormat(ABitmap) >= 32) and InternalIsBitmapAlphaUsed;
end;

// getting graphic objects' data
function dxGetBitmapData(ABitmapHandle: HBITMAP; out ABitmapData: Windows.TBitmap): Boolean;
begin
  Result := GetObject(ABitmapHandle, SizeOf(Windows.TBitmap), @ABitmapData) <> 0;
end;

function dxGetBrushData(ABrushHandle: HBRUSH; out ALogBrush: TLogBrush): Boolean;
begin
  Result := GetObject(ABrushHandle, SizeOf(TLogBrush), @ALogBrush) <> 0;
end;

function dxGetBrushData(ABrushHandle: HBRUSH): TLogBrush;
begin
  dxGetBrushData(ABrushHandle, Result);
end;

function dxGetFontData(AFontHandle: HFONT; out ALogFont: TLogFont): Boolean;
begin
  Result := GetObject(AFontHandle, SizeOf(TLogFont), @ALogFont) <> 0;
end;

function dxGetFontData(AFontHandle: HFONT): TLogFont;
begin
  dxGetFontData(AFontHandle, Result);
end;

function dxGetPenData(APenHandle: HPEN; out ALogPen: TLogPen): Boolean;
begin
  Result := GetObject(APenHandle, SizeOf(TLogPen), @ALogPen) <> 0;
end;

end.











